home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue49 / ComCorn / Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-02  |  9.5 KB  |  260 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, ComObj, ActiveX, SteveAddIn_TLB, AddInDesignerObjects_TLB, Office_TLB,
  7.   EventSink;
  8.  
  9. type
  10.   TOfficeHostApp = (ohaExcel, ohaWord, ohaOutlook, ohaPowerPoint, ohaAccess);
  11.   TOfficeHostApps = set of TOfficeHostApp;
  12.  
  13.   TSteveAddIn = class(TAutoObject, ISteveAddIn, IDTExtensibility2)
  14.   private
  15.     FApplication: OleVariant;
  16.     FButton: CommandBarButton;
  17.     FCommandBar: CommandBar;
  18.     FCookie: Longint;
  19.     FEventSink: TEventSink;
  20.     FHostApp: TOfficeHostApp;
  21.   protected
  22.     { IDTExtensibility2 methods }
  23.     procedure OnConnection(const Application_: IDispatch;
  24.       ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;
  25.       var custom: PSafeArray); safecall;
  26.     procedure OnDisconnection(RemoveMode: ext_DisconnectMode;
  27.       var custom: PSafeArray); safecall;
  28.     procedure OnAddInsUpdate(var custom: PSafeArray); safecall;
  29.     procedure OnStartupComplete(var custom: PSafeArray); safecall;
  30.     procedure OnBeginShutdown(var custom: PSafeArray); safecall;
  31.   public
  32.     procedure CommandBarButtonClick(const Ctrl: CommandBarButton;
  33.       var CancelDefault: WordBool);
  34.     property Application: OleVariant read FApplication;
  35.     property HostApp: TOfficeHostApp read FHostApp;
  36.   end;
  37.  
  38.   TOfficeAddInFactory = class(TAutoObjectFactory)
  39.   private
  40.     FFriendlyName: string;
  41.     FLoadBehavior: Integer;
  42.     FSupportedApps: TOfficeHostApps;
  43.     procedure ReallyDeleteRegKey(const KeyName: string);
  44.   protected
  45.     procedure RegisterAddIn(const KeyName: string); virtual;
  46.   public
  47.     constructor Create(ComServer: TComServerObject; AutoClass: TAutoClass;
  48.       const ClassID: TGUID; Instancing: TClassInstancing;
  49.       ThreadingModel: TThreadingModel; SupportedApps: TOfficeHostApps;
  50.       const FriendlyName: string; LoadBehavior: Integer);
  51.     procedure UpdateRegistry(Register: Boolean); override;
  52.   end;
  53.  
  54. implementation
  55.  
  56. uses SysUtils, ComServ, Excel_TLB, Word_TLB, Dialogs, CmdBarHack, Registry,
  57.   Classes;
  58.  
  59. { TSteveAddIn }
  60.  
  61. // CommandBarButtonClick is the click handler for our command bar button
  62. procedure TSteveAddIn.CommandBarButtonClick(const Ctrl: CommandBarButton;
  63.   var CancelDefault: WordBool);
  64. begin
  65.   // Let the user know that the button was clicked.  In real life, you'd do
  66.   // something more userful in here.
  67.   ShowMessage('You clicked on the button!');
  68. end;
  69.  
  70. // OnAddInsUpdate is called to notify the add-in that the Office host
  71. // application's COMAddIns collection has changed.
  72. procedure TSteveAddIn.OnAddInsUpdate(var custom: PSafeArray);
  73. begin
  74.   // nothing to do here
  75. end;
  76.  
  77. // OnBeginShutdown is called immediately prior to the Office host application
  78. // going into its shutdown routine.
  79. procedure TSteveAddIn.OnBeginShutdown(var custom: PSafeArray);
  80. begin
  81.   // Unhook event sink
  82.   InterfaceDisconnect(FButton, DIID__CommandBarButtonEvents, FCookie);
  83.   // Kill Button and CommandBar
  84.   FButton.Delete(False);
  85.   FCommandBar.Delete;
  86. end;
  87.  
  88. // OnConnection is called when the add-in is loaded by the Office host
  89. // application.  The add-in can be loaded under any one of several circumstances,
  90. // as  indicated by the value of the  ConnectMode parameter:
  91. //
  92. //   ext_cm_AfterStartup: add-in was loaded after startup (by the end user)
  93. //   ext_cm_Startup:      add-in was loaded during startup (normal mode)
  94. //   ext_cm_External:     add-in was loaded from an external source (like a
  95. //                        VBA macro or another component)
  96. //   ext_cm_CommandLine:  add-in whas loaded from the command line
  97. //
  98. // The Application_ parameter contains an IDispatch for the "application"
  99. // interface of the Office host application.  The AddInInst contains an
  100. // IDispatch representing this add-in in the Office host application's COMAddIns
  101. // collection.
  102. procedure TSteveAddIn.OnConnection(const Application_: IDispatch;
  103.   ConnectMode: ext_ConnectMode; const AddInInst: IDispatch;
  104.   var custom: PSafeArray);
  105. var
  106.   Unk: IUnknown;
  107. begin
  108.   // QueryInterface for the "application" interface of the Office host
  109.   // applications that we support.  When we find one, we know who is our host.
  110.   if Application_.QueryInterface(Word_TLB._Application, Unk) = S_OK then
  111.     FHostApp := ohaWord
  112.   else if Application_.QueryInterface(Excel_TLB._Application, Unk) = S_OK then
  113.     FHostApp := ohaExcel
  114.   else begin
  115.     MessageDlg('This Add-in only supports Word and Excel.', mtError,
  116.       [mbOk], 0);
  117.     raise SysUtils.Exception.Create('Initialization failed');
  118.   end;
  119.   FApplication := Application_;
  120.   // If we are connecting during startup, then OnStartupComplete will be called
  121.   // by the Office host application, and we should perform our initialization
  122.   // there.  Otherwise, we'll assume Office is already initialized and call
  123.   // OnStartupComplete ourselves.
  124.   if (ConnectMode <> ext_cm_Startup) then OnStartupComplete(custom);
  125. end;
  126.  
  127. // OnDisconnection is called when the add-in is unloaded by the Office
  128. // host application.  This occurs wither when the user manually unloads the
  129. // add-in (RemoveMode = ext_dm_UserClosed) or the Office host application shuts
  130. // down (RemoveMode = ext_dm_HostShutdown).
  131. procedure TSteveAddIn.OnDisconnection(RemoveMode: ext_DisconnectMode;
  132.   var custom: PSafeArray);
  133. begin
  134.   // If we are not unloading as a result of the host shutting down,
  135.   // OnBeginShutdown won't be called by the Office host application, so we call
  136.   // it manually in order to clean up toolbar.
  137.   if (RemoveMode <> ext_dm_HostShutdown) then OnBeginShutdown(custom);
  138.   FEventSink.Free;
  139.   // Release all references
  140.   FButton := nil;
  141.   FCommandBar := nil;
  142.   FApplication := Unassigned;
  143. end;
  144.  
  145. // OnStartupComplete is called after the Office host application has completed
  146. // its startup rigmarole, including loading of any necessary files, add-ins, or
  147. // other objects into memory.  This method is not called for add-ins that are
  148. // loaded by the user or by VBA code, however we are calling it from
  149. // OnConnection to ensure the code in this method is always called.
  150. procedure TSteveAddIn.OnStartupComplete(var custom: PSafeArray);
  151. var
  152.   CmdBars: CommandBars;
  153.   Control: CommandBarControl;
  154.   I: Integer;
  155. begin
  156.   CmdBars := CommandBars(GetAppCommandBars(FApplication));
  157.   // Need to iterate over CommandBars to see if we are already installed.
  158.   // If not, create a new one.
  159.   for I := 1 to CmdBars.Count do
  160.     if CmdBars.Item[I].Name = 'StevesCommandBar' then
  161.       FCommandBar := CmdBars.Item[I];
  162.   if FCommandBar = nil then
  163.     FCommandBar := CmdBars.Add('StevesCommandBar', EmptyParam, EmptyParam, EmptyParam);
  164.   // If CommandBar already has a control on it, then assume it's our button,
  165.   // otherwise add a new one.
  166.   if FCommandBar.Controls_.Count > 0 then
  167.     Control := FCommandBar.COntrols_.Item[1]
  168.   else
  169.     Control := FCommandBar.Controls_.Add(msoControlButton, EmptyParam,
  170.       EmptyParam, EmptyParam, EmptyParam);
  171.   FButton := CommandBarButton(Control);
  172.   FButton.Caption := 'Steve''s Add-in';
  173.   FButton.Style := msoButtonCaption;
  174.   FButton.Visible := True;
  175.   // hook up Click event
  176.   FEventSink := TEventSink.Create(CommandBarButtonClick);
  177.   InterfaceConnect(FButton, DIID__CommandBarButtonEvents, FEventSink, FCookie);
  178.   FCommandBar.Visible := True;
  179. end;
  180.  
  181. { TOfficeAddInFactory }
  182.  
  183. constructor TOfficeAddInFactory.Create(ComServer: TComServerObject;
  184.   AutoClass: TAutoClass; const ClassID: TGUID;
  185.   Instancing: TClassInstancing; ThreadingModel: TThreadingModel;
  186.   SupportedApps: TOfficeHostApps; const FriendlyName: string;
  187.   LoadBehavior: Integer);
  188. begin
  189.   inherited Create(ComServer, AutoClass, ClassID, Instancing, ThreadingModel);
  190.   FSupportedApps := SupportedApps;
  191.   FFriendlyName := FriendlyName;
  192.   FLoadBehavior := LoadBehavior;
  193. end;
  194.  
  195. procedure TOfficeAddInFactory.ReallyDeleteRegKey(const KeyName: string);
  196. var
  197.   R: TRegistry;
  198.   Values: TStringList;
  199.   I: Integer;
  200. begin
  201.   // Deletes a reg key, including underlying values
  202.   Values := TStringList.Create;
  203.   R := TRegistry.Create;
  204.   try
  205.     if R.OpenKey(KeyName, False) then
  206.     begin
  207.       R.GetValueNames(Values);
  208.       for I := 0 to Values.Count - 1 do
  209.         R.DeleteValue(Values[I]);
  210.       R.CloseKey;
  211.       R.DeleteKey(KeyName);
  212.     end;
  213.   finally
  214.     R.Free;
  215.     Values.Free;
  216.   end;
  217. end;
  218.  
  219. procedure TOfficeAddInFactory.RegisterAddIn(const KeyName: string);
  220. var
  221.   R: TRegistry;
  222. begin
  223.   R := TRegistry.Create;
  224.   try
  225.     // Makes necessary registry entries to register this COM server as an add-in
  226.     if not R.OpenKey(KeyName, True) then raise Exception.Create('');
  227.     R.WriteString('FriendlyName', FFriendlyName);
  228.     R.WriteString('Description', Description);
  229.     R.WriteInteger('LoadBehavior', FLoadBehavior);
  230.     R.WriteInteger('CommandLineSafe', 0);
  231.   finally
  232.     R.Free;
  233.   end;
  234. end;
  235.  
  236. procedure TOfficeAddInFactory.UpdateRegistry(Register: Boolean);
  237. const
  238.   AppNames: array[TOfficeHostApp] of string[15] = ('Excel', 'Word', 'Outlook',
  239.     'PowerPoint', 'Access');
  240.   AddInKey = '\Software\Microsoft\Office\%s\AddIns\%s';
  241. var
  242.   I: TOfficeHostApp;
  243.   CurrentAddInKey: string;
  244. begin
  245.   inherited UpdateRegistry(Register);
  246.   // iterate over all supported apps and update registry
  247.   for I := Low(TOfficeHostApp) to High(TOfficeHostApp) do
  248.     if I in FSupportedApps then
  249.     begin
  250.       CurrentAddInKey := Format(AddInKey, [AppNames[I], ProgID]);
  251.       if Register then RegisterAddIn(CurrentAddInKey)
  252.       else ReallyDeleteRegKey(CurrentAddInKey);
  253.     end;
  254. end;
  255.  
  256. initialization
  257.   TOfficeAddInFactory.Create(ComServer, TSteveAddIn, Class_SteveAddIn_,
  258.     ciMultiInstance, tmApartment, [ohaExcel, ohaWord], 'Steve''s Add-in', 3);
  259. end.
  260.